home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / thomas / thomas.lha / Thomas / Thomas-1.1 / src / runtime-collections-range.scm < prev    next >
Text File  |  1992-08-30  |  20KB  |  533 lines
  1. ;*              Copyright 1992 Digital Equipment Corporation
  2. ;*                         All Rights Reserved
  3. ;*
  4. ;* Permission to use, copy, and modify this software and its documentation is
  5. ;* hereby granted only under the following terms and conditions.  Both the
  6. ;* above copyright notice and this permission notice must appear in all copies
  7. ;* of the software, derivative works or modified versions, and any portions
  8. ;* thereof, and both notices must appear in supporting documentation.
  9. ;*
  10. ;* Users of this software agree to the terms and conditions set forth herein,
  11. ;* and hereby grant back to Digital a non-exclusive, unrestricted, royalty-free
  12. ;* right and license under any changes, enhancements or extensions made to the
  13. ;* core functions of the software, including but not limited to those affording
  14. ;* compatibility with other hardware or software environments, but excluding
  15. ;* applications which incorporate this software.  Users further agree to use
  16. ;* their best efforts to return to Digital any such changes, enhancements or
  17. ;* extensions that they make and inform Digital of noteworthy uses of this
  18. ;* software.  Correspondence should be provided to Digital at:
  19. ;* 
  20. ;*            Director, Cambridge Research Lab
  21. ;*            Digital Equipment Corp
  22. ;*            One Kendall Square, Bldg 700
  23. ;*            Cambridge MA 02139
  24. ;* 
  25. ;* This software may be distributed (but not offered for sale or transferred
  26. ;* for compensation) to third parties, provided such third parties agree to
  27. ;* abide by the terms and conditions of this notice.
  28. ;* 
  29. ;* THE SOFTWARE IS PROVIDED "AS IS" AND DIGITAL EQUIPMENT CORP. DISCLAIMS ALL
  30. ;* WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
  31. ;* MERCHANTABILITY AND FITNESS.   IN NO EVENT SHALL DIGITAL EQUIPMENT
  32. ;* CORPORATION BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
  33. ;* DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
  34. ;* PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
  35. ;* ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
  36. ;* SOFTWARE.
  37.  
  38. ; $Id: runtime-collections-range.scm,v 1.24 1992/08/31 05:16:08 birkholz Exp $
  39.  
  40. ;;;; Specializations for Range Type
  41.  
  42. (add-method dylan:as
  43.   (dylan::function->method
  44.    (make-param-list
  45.     `((CLASS ,(dylan::make-singleton <range>)) (COLLECTION ,<collection>))
  46.     #F #F #F)
  47.    (lambda (class collection)
  48.      (if (dylan-call dylan:instance? collection <range>)
  49.      collection
  50.      (let ((size (dylan-call dylan:size collection)))
  51.        (cond ((= size 0) (dylan-call dylan:make <range>))
  52.          ((= size 1) (dylan-call
  53.                   dylan:range 'from:
  54.                   (dylan-call dylan:current-element collection
  55.                       (dylan-call
  56.                        dylan:initial-state collection))
  57.                   'size: 1))
  58.          ((negative? size)
  59.           (dylan-call dylan:error "(as (singleton <range>) <collection>) -- internal error.size retured negative number" size class collection))
  60.          (else
  61.           (let* ((state (dylan-call dylan:initial-state collection))
  62.              (first (dylan-call
  63.                  dylan:current-element collection state))
  64.              (state-2
  65.               (dylan-call dylan:next-state collection state))
  66.              (second (dylan-call
  67.                   dylan:current-element collection state-2)))
  68.             (if (and (dylan-call dylan:subclass?
  69.                      (get-type first) <number>)
  70.                  (dylan-call dylan:subclass?
  71.                      (get-type second) <number>))
  72.             (let ((step (dylan-call dylan:- second first)))
  73.               (let loop ((state (dylan-call
  74.                          dylan:next-state
  75.                          collection state-2))
  76.                      (prev second))
  77.                 (if state
  78.                 (let ((cur (dylan-call
  79.                         dylan:current-element
  80.                         collection state)))
  81.                   (if (dylan-call
  82.                        dylan:= step
  83.                        (dylan-call dylan:- cur prev))
  84.                       (loop (dylan-call dylan:next-state
  85.                             collection state)
  86.                         (dylan-call
  87.                          dylan:current-element
  88.                          collection state))
  89.                       (dylan-call dylan:error "(as (singleton <range>) <collection>) -- numbers not in sync" class collection)))
  90.                 (dylan-call dylan:range 'from: first 'by: step
  91.                         'through: prev))))
  92.             (dylan-call dylan:error "(as (singleton <range>) <collection>) -- elements are not numbers" class collection))))))))))
  93.  
  94.  
  95. ;;;
  96. ;;; RANGE SPECIALIZED MAKE
  97. ;;; <range> has three slots: start, step, end
  98. ;;;   #F for end means unbounded range.
  99. ;;; Ranges can't be made by calling make, only range
  100. ;;;
  101. (define dylan:get-range-start "define dylan:get-range-start")
  102. (define dylan:get-range-step "define dylan:get-range-step")
  103. (define dylan:get-range-end "define dylan:get-range-end")
  104. (define dylan:set-range-start! "define dylan:set-range-start!")
  105. (define dylan:set-range-step! "define dylan:set-range-step!")
  106. (define dylan:set-range-end! "define dylan:set-range-end!")
  107.  
  108. (create-private-slot <range> <object> "internal-range-start"
  109.   (lambda (set get)
  110.     (set! dylan:set-range-start! set)
  111.     (set! dylan:get-range-start get)))
  112. (create-private-slot <range> <object> "internal-range-step"
  113.   (lambda (set get)
  114.     (set! dylan:set-range-step! set)
  115.     (set! dylan:get-range-step get)))
  116. (create-private-slot <range> <object> "internal-range-end"
  117.   (lambda (set get)
  118.     (set! dylan:set-range-end! set)
  119.     (set! dylan:get-range-end get)))
  120.  
  121. (add-method dylan:make
  122.   (dylan::function->method
  123.    (make-param-list `((RANGE ,(dylan::make-singleton <range>)))
  124.             #F #F #T)
  125.    (lambda (range . rest)
  126.      range                ; Not used
  127.      rest                ; Not used
  128.      (dylan-call dylan:range 'from: 0 'through: -1 'by: 1))))
  129.  
  130. ;;;
  131. ;;; FUNCTIONS FOR COLLECTIONS (page 99)
  132. ;;;
  133. (add-method dylan:size
  134.   (one-arg 'RANGE <range>
  135.    (lambda (range)
  136.      (let ((start (dylan-call dylan:get-range-start range))
  137.        (end (dylan-call dylan:get-range-end range))
  138.        (step (dylan-call dylan:get-range-step range)))
  139.        (if end
  140.        (if ((if (positive? step) < >) end start)
  141.            0
  142.            (+ (abs (/ (- end start) step)) 1))
  143.        #F)))))
  144.  
  145. (add-method dylan:class-for-copy
  146.   (dylan::function->method one-range (lambda (x) x <list>)))
  147.  
  148.  
  149. (add-method
  150.  dylan:member?
  151.  (dylan::dylan-callable->method
  152.   (make-param-list `((VALUE ,<object>) (RANGE ,<range>)) #F #F '(test:))
  153.   (lambda (multiple-values next-method val range . keys)
  154.     multiple-values
  155.     (dylan::keyword-validate next-method keys '(test:))
  156.     (let ((test (dylan::find-keyword keys 'test: (lambda () #F))))
  157.       (if test
  158.       (dylan-call
  159.        dylan:error
  160.        "(member? <object> <range>) -- test: keyword argument not supported"
  161.        test)))
  162.     (let ((start (dylan-call dylan:get-range-start range))
  163.       (end (dylan-call dylan:get-range-end range))
  164.       (step (dylan-call dylan:get-range-step range)))
  165.       (if (not (number? val))
  166.       #F
  167.       (and ((if (negative? step) <= >=) val start)
  168.            (or (not end)
  169.            ((if (negative? step)
  170.             >=
  171.             <=)
  172.             val end))
  173.            (= 0 (remainder (- val start) step))))))))
  174.  
  175. ;;;;
  176. ;;;; Functions for Sequences (page 104)
  177. ;;;;
  178. (add-method dylan:add
  179.  (dylan::function->method one-range-and-an-object
  180.    (lambda (the-range new-element)
  181.      (if (not (dylan-call dylan:subclass?
  182.               (dylan-call dylan:object-class new-element)
  183.               <number>))
  184.      (dylan-call dylan:error
  185.              "(add <range> <object>) -- new element not a number"
  186.              the-range new-element))
  187.      (let ((size (dylan-call dylan:size the-range))
  188.        (start (dylan-call dylan:get-range-start the-range))
  189.        (end (dylan-call dylan:get-range-end the-range))
  190.        (step (dylan-call dylan:get-range-step the-range)))
  191.        (cond ((not size)
  192.           (if (= start (+ new-element step))
  193.           (dylan-call dylan:range
  194.                   'from: new-element
  195.                   'by: step)
  196.           (dylan-call dylan:error "(add <range> <object>) -- cannot add this number to unbound range" the-range new-element)))
  197.          ((= size 0) (dylan-call dylan:range
  198.                      'from: new-element
  199.                      'through: new-element
  200.                      'by: 1))
  201.          ((= size 1) (dylan-call dylan:range
  202.                      'from: new-element
  203.                      'through: start
  204.                      'by: (- start new-element)))
  205.          (else
  206.           (if (= start (+ new-element step))
  207.           (dylan-call dylan:range 'from: new-element
  208.                   'through: end
  209.                   'by: step)
  210.           (if (= end (- new-element step))
  211.               (dylan-call dylan:range
  212.                   'from: start
  213.                   'through: new-element
  214.                   'by: step)
  215.               (dylan-call dylan:error "(add <range> <object>) -- cannot add this number to range" the-range new-element)))))))))
  216.  
  217. (add-method dylan:add!
  218.   (dylan::function->method one-range-and-an-object
  219.    (lambda (the-range new-element)
  220.      (if (not (dylan-call dylan:subclass?
  221.               (dylan-call dylan:object-class new-element)
  222.               <number>))
  223.      (dylan-call dylan:error
  224.              "(add! <range> <object>) -- new element not a number"
  225.              the-range new-element))
  226.      (let ((size (dylan-call dylan:size the-range))
  227.        (start (dylan-call dylan:get-range-start the-range))
  228.        (end (dylan-call dylan:get-range-end the-range))
  229.        (step (dylan-call dylan:get-range-step the-range)))
  230.        (cond ((not size)
  231.           (if (= start (+ new-element step))
  232.           (dylan-call dylan:set-range-start! the-range new-element)
  233.           (dylan-call dylan:error "(add <range> <object>) -- cannot add this number to unbound range" the-range new-element)))
  234.          ((= size 0)
  235.           (dylan-call dylan:set-range-start! the-range new-element)
  236.           (dylan-call dylan:set-range-end! the-range new-element)
  237.           (dylan-call dylan:set-range-step! the-range 1))
  238.          ((= size 1)
  239.           (dylan-call dylan:set-range-start! the-range new-element)
  240.           (dylan-call dylan:set-range-end! the-range start)
  241.           (dylan-call dylan:set-range-step! the-range
  242.               (- start new-element)))
  243.          (else
  244.           (if (= start (+ new-element step))
  245.           (dylan-call dylan:set-range-start! the-range new-element)
  246.           (if (= end (- new-element step))
  247.               (dylan-call dylan:set-range-end! the-range new-element)
  248.               (dylan-call dylan:error "(add <range> <object>) -- cannot add this number to range" the-range new-element)))))
  249.        the-range))))            ; Return the modified range
  250.  
  251.  
  252. (add-method
  253.  dylan:remove!
  254.  (dylan::dylan-callable->method
  255.   (make-param-list `((RANGE ,<range>) (VALUE ,<object>)) #F #F '(count: test:))
  256.   (lambda (multiple-values next-method range value . rest)
  257.     multiple-values
  258.     (dylan::keyword-validate next-method rest '(count: test:))
  259.     (let ((test (dylan::find-keyword rest 'test: (lambda () dylan:id?)))
  260.       (count (dylan::find-keyword rest 'count:
  261.                       (lambda ()
  262.                     (dylan-call dylan:size range)))))
  263.       (if count
  264.       (dylan-call dylan:remove range value 'test: test 'count: count)
  265.       (dylan-call dylan:remove range value 'test: test))))))
  266.  
  267.  
  268. (add-method
  269.  dylan:remove-duplicates!
  270.  (dylan::dylan-callable->method
  271.   (make-param-list `((RANGE ,<range>)) #F #F '(test:))
  272.   (lambda (multiple-values next-method range . rest)
  273.     multiple-values
  274.     (dylan::keyword-validate next-method rest '(test:))
  275.     (let ((test (dylan::find-keyword rest 'test: (lambda () dylan:id?))))
  276.       (dylan-call dylan:remove-duplicates range 'test: test)))))
  277.  
  278.  
  279. (add-method
  280.  dylan:copy-sequence
  281.  (dylan::dylan-callable->method
  282.   (make-param-list `((RANGE ,<range>)) #F #F '(start: end:))
  283.   (lambda (multiple-values next-method range . rest)
  284.     multiple-values
  285.     (dylan::keyword-validate next-method rest '(start: end:))
  286.     (let ((start (dylan::find-keyword
  287.           rest 'start:
  288.           (lambda () (dylan-call dylan:get-range-start range))))
  289.       (end (dylan::find-keyword
  290.         rest
  291.         'end: (lambda () (dylan-call dylan:get-range-end range))))
  292.       (step (dylan-call dylan:get-range-step range)))
  293.       (if (and end (not (= 0 (remainder (- end start) step))))
  294.       (dylan-call
  295.        dylan:error
  296.        "(copy-subsequence <range>) -- bad start and/or end parameters"
  297.        range start end))
  298.       (dylan-call dylan:range 'from: start 'through: end 'by: step)))))
  299.  
  300.  
  301. (add-method dylan:concatenate
  302.   (dylan::function->method
  303.     (make-param-list `((RANGE ,<range>)) #F 'REST #F)
  304.     (lambda (range-1 . rest)
  305.       (let ((end-1 (dylan-call dylan:get-range-end range-1))
  306.         (step-1 (dylan-call dylan:get-range-step range-1))
  307.         (result (dylan-call dylan:copy-sequence range-1)))
  308.     (if (not end-1)
  309.         (dylan-call dylan:error
  310.             "(concatenate <range> !rest) -- range is unbound"
  311.             range-1 rest))
  312.     (let loop ((rest-ranges (map
  313.                  (lambda (collection)
  314.                    (dylan-call dylan:as <range> collection))
  315.                  rest)))
  316.       (if (null? rest-ranges)
  317.           result
  318.           (let* ((next-range (car rest-ranges))
  319.              (start-2 (dylan-call dylan:get-range-start next-range))
  320.              (end-2 (dylan-call dylan:get-range-end next-range))
  321.              (step-2 (dylan-call dylan:get-range-step next-range))
  322.              (size (dylan-call dylan:size next-range)))
  323.         (if (not end-2)
  324.             (dylan-call
  325.              dylan:error
  326.              "(concatenate <range> !rest) -- range is unbound"
  327.              next-range range-1 rest))
  328.         (if (positive? size)
  329.             (if (and (= start-2 (+ end-1 step-1))
  330.                  (or (= step-1 step-2) (= size 1)))
  331.             (begin
  332.               (dylan-call dylan:set-range-end! result end-2)
  333.               (set! end-1 end-2)
  334.               (loop (cdr rest-ranges)))
  335.             (dylan-call
  336.              dylan:error
  337.              "(concatenate <range> !rest) -- incompatible ranges"
  338.              next-range result range-1 rest))
  339.             (loop (cdr rest-ranges))))))))))
  340.  
  341.  
  342. (add-method dylan:reverse
  343.   (dylan::function->method one-range
  344.     (lambda (range)
  345.       (let ((start (dylan-call dylan:get-range-start range))
  346.         (end (dylan-call dylan:get-range-end range))
  347.         (step (dylan-call dylan:get-range-step range)))
  348.     (if end
  349.         (dylan-call dylan:range 'from: end 'through: start 'by: (- step))
  350.         (dylan-call dylan:error
  351.             "(reverse <range>) -- can't reverse unbounded range"
  352.             range))))))
  353.  
  354. (add-method dylan:reverse!
  355.   (dylan::function->method one-range
  356.     (lambda (range)
  357.       (let ((start (dylan-call dylan:get-range-start range))
  358.         (end (dylan-call dylan:get-range-end range))
  359.         (step (dylan-call dylan:get-range-step range)))
  360.     (if end
  361.         (begin
  362.           (dylan-call dylan:set-range-start! range end)
  363.           (dylan-call dylan:set-range-end! range start)
  364.           (dylan-call dylan:set-range-step! range (- step))
  365.           range)
  366.         (dylan-call dylan:error
  367.             "(reverse! <range>) -- can't reverse unbounded range"
  368.             range))))))
  369.  
  370. (add-method dylan:last
  371.   (dylan::function->method one-range
  372.     (lambda (range)
  373.       (let ((end (dylan-call dylan:get-range-end range)))
  374.     (or end
  375.         (dylan-call dylan:error
  376.             "(last <range>) -- no end in sight for this range"
  377.             range))))))
  378.  
  379.  
  380. ;;;;
  381. ;;;; Operations on Ranges (page 118)
  382. ;;;;
  383.  
  384. (define dylan:range
  385.   (dylan::generic-fn 'range only-rest-args #F))
  386.  
  387. (add-method
  388.  dylan:range
  389.  (dylan::dylan-callable->method
  390.   (make-param-list '() #F #F '(by: through: from: up-to: size:))
  391.   (lambda (multiple-values next-method . rest)
  392.     multiple-values
  393.     (dylan::keyword-validate next-method rest
  394.                  '(by: through: from: up-to: size:))
  395.     (let* ((from (dylan::find-keyword rest 'from: (lambda () 0)))
  396.        (up-to (dylan::find-keyword rest 'up-to: (lambda () #F)))
  397.        (through (dylan::find-keyword rest 'through: (lambda () #F)))
  398.        (by (dylan::find-keyword rest 'by: (lambda () 1)))
  399.        (size (dylan::find-keyword rest 'size: (lambda () #F)))
  400.        (by-negative? (negative? by))
  401.        (not-in-range (- from by))
  402.        (up-to->through (if up-to
  403.                    (+ from
  404.                   (* (ceiling (- (/ (- up-to from) by) 1))
  405.                      by))
  406.                    not-in-range))
  407.        (through->through (if through
  408.                  (+ from
  409.                     (* (floor (/ (- through from) by))
  410.                        by))
  411.                  not-in-range))
  412.        (size->through (if (and size (positive? size))
  413.                   (+ from (* (- size 1) by))
  414.                   not-in-range))
  415.        (max-through ((if by-negative? min max)
  416.              up-to->through through->through size->through)))
  417.       (let ((range (dylan::make-<object> <range>)))
  418.     (dylan-call dylan:set-range-start! range from)
  419.     (dylan-call dylan:set-range-step! range by)
  420.     (if (not (or up-to through size))
  421.         (dylan-call dylan:set-range-end! range #F)
  422.         (dylan-call dylan:set-range-end! range max-through))
  423.     range)))))
  424.  
  425. (add-method dylan:binary=
  426.   (dylan::function->method
  427.      two-ranges
  428.      (lambda (range-1 range-2)
  429.        (let ((start-1 (dylan-call dylan:get-range-start range-1))
  430.          (end-1 (dylan-call dylan:get-range-end range-1))
  431.          (step-1 (dylan-call dylan:get-range-step range-1))
  432.          (start-2 (dylan-call dylan:get-range-start range-2))
  433.          (end-2 (dylan-call dylan:get-range-end range-2))
  434.          (step-2 (dylan-call dylan:get-range-step range-2))
  435.          (size-1 (dylan-call dylan:size range-1))
  436.          (size-2 (dylan-call dylan:size range-2)))
  437.      (cond ((or (and size-1 (not size-2))
  438.             (and (not size-1) size-2)) #F) ; One is unbound
  439.            ((not (and size-1 size-2))          ; Both unbound
  440.         (and (= start-1 start-2) (= step-1 step-2)))
  441.            ((= 0 size-1 size-2) #T)            ; Empty ranges are binary=
  442.            (else (and (= start-1 start-2)
  443.               (= step-1 step-2)
  444.               (= end-1 end-2))))))))
  445.  
  446. ;;
  447. ;; Find-First-Intersection: Given two ranges, and a start value which is in
  448. ;;                          the first range, find the first common number to
  449. ;;                          both ranges from start, if any?
  450. ;;
  451. (define (find-first-intersection start range1 range2)
  452.   (let* ((by-lcm (lcm (dylan-call dylan:get-range-step range1)
  453.               (dylan-call dylan:get-range-step range2)))
  454.      (step1 (dylan-call dylan:get-range-start range1))
  455.      (done-value ((if (negative? step1) - +) start by-lcm)))
  456.     (let loop ((state start))        ; Assumes state is the actual number
  457.       (display (list 'loop 'state state 'done done-value)) (newline)
  458.       (if state
  459.       (let ((cur-element
  460.          (dylan-call dylan:current-element range1 state)))
  461.         (cond ((dylan-call dylan:member? cur-element range2)
  462.            cur-element)
  463.           ((= cur-element done-value) #F)
  464.           (else
  465.            (loop
  466.             (dylan-call dylan:next-state range1 state)))))
  467.       #F))))            ; No intersection
  468.  
  469. (add-method
  470.  dylan:intersection
  471.  (dylan::dylan-callable->method
  472.   (make-param-list `((RANGE-1 ,<range>) (RANGE-2 ,<range>)) #F #F '(test:))
  473.   (lambda (multiple-values next-method range-1 range-2 . rest)
  474.     multiple-values
  475.     (dylan::keyword-validate next-method rest '(test:))
  476.     (let ((test (dylan::find-keyword rest 'test: (lambda () #F))))
  477.       (if test
  478.       (dylan-call dylan:error
  479.               "(intersection <range> <range>) -- test: keyword argument not supported" test)))
  480.     (let* ((start-1 (dylan-call dylan:get-range-start range-1))
  481.        (end-1 (dylan-call dylan:get-range-end range-1))
  482.        (step-1 (dylan-call dylan:get-range-step range-1))
  483.        (start-2 (dylan-call dylan:get-range-start range-2))
  484.        (end-2 (dylan-call dylan:get-range-end range-2))
  485.        (step-2 (dylan-call dylan:get-range-step range-2))
  486.        (by-lcm (lcm step-1 step-2)))
  487.  
  488.       (cond ((or (zero? step-1) (zero? step-2))
  489.          (if (= start-1 start-2)
  490.          range-1
  491.          (dylan-call dylan:make <range>)))
  492.         ((and (positive? step-1) (positive? step-2))
  493.          (let ((first-intersection
  494.             (find-first-intersection (max start-1 start-2)
  495.                          range-1 range-2)))
  496.            (if first-intersection
  497.            (if (or end-1 end-2)
  498.                (dylan-call dylan:range
  499.                    'from: first-intersection
  500.                    'through: (if (and end-1 end-2)
  501.                          (min end-1 end-2)
  502.                          (or end-1 end-2))
  503.                    'by:  by-lcm)
  504.                (dylan-call dylan:range
  505.                    'from: first-intersection
  506.                    'by:  by-lcm))
  507.            (dylan-call dylan:make <range>))))
  508.         ((and (negative? step-1) (negative? step-2)) ; *****
  509.          '...)
  510.         ((and (positive? step-1) (negative? step-2)) ; *****
  511.          '...)
  512.         ((and (negative? step-1) (positive? step-2)) ; *****
  513.          '...)
  514.         (else
  515.          (dylan-call dylan:error
  516.              "(intersection <range> <range>) -- internal error"
  517.              range-1 range-2 rest)))))))
  518.  
  519.  
  520. ;;;
  521. ;;; Mutable Collection
  522. ;;;
  523.  
  524. (add-method dylan:setter/current-element/
  525.   (dylan::function->method
  526.     (make-param-list
  527.      `((RANGE ,<range>) (STATE ,<object>) (new-value ,<object>))
  528.      #F #F #F)
  529.     (lambda (range state new-value)
  530.       (dylan-call dylan:error
  531.           "((setter current-element) <range>) -- range not mutable"
  532.           range state new-value))))
  533.